home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / tf_sourc / mouse256.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-16  |  9.8 KB  |  428 lines
  1. UNIT Mouse256;   { by »The Faker« in 1992 }
  2. INTERFACE
  3. USES
  4.     Crt,Dos;
  5. TYPE
  6.     MouseMenuFlags=ARRAY[1..20] OF Boolean;
  7.     MaskType=ARRAY[0..1,0..15] OF Word;
  8.     MaskPointer=^MaskRec;
  9.     MaskRec=RECORD
  10.                   Mask:MaskType;
  11.                   X,Y:Word;
  12.             END;
  13. VAR
  14.    RightArrowCursor,DownArrowCursor,InvertedCursor:MaskRec;
  15. CONST
  16.      LeftB:Byte=0;
  17.      RightB:Byte=1;
  18.      StandardCursor:MaskRec=(Mask:(($3FFF,$1FFF,$0FFF,$07FF,$03FF,$01FF,$00FF,$007F,$003F,$001F,$01FF,$10FF,$30FF,$F87F,
  19.      $F87F,$FC3F),($0000,$4000,$6000,$7000,$7800,$7C00,$7E00,$7F00,$7F80,$7FC0,$7C00,$4600,$0600,$0300,$0300,$0180));X:0;Y:0);
  20.      UpArrowCursor:MaskRec=(Mask:(($F9FF,$F0FF,$E07F,$E07F,$C03F,$C03F,$801F,$801F,$000F,$000F,$F0FF,$F0FF,$F0FF,$F0FF,
  21.      $F0FF,$F0FF),($0000,$0600,$0F00,$0F00,$1F80,$1F80,$3FC0,$3FC0,$7FE0,$0600,$0600,$0600,$0600,$0600,$0600,$0600));X:5;Y:0);
  22.      LeftArrowCursor:MaskRec=(Mask:(($FE1F,$F01F,$0000,$0000,$0000,$F01F,$FE1F,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,
  23.      $FFFF,$FFFF),($0000,$00C0,$07C0,$7FFE,$07C0,$00C0,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));X:0;Y:3);
  24.      CheckMarkCursor:MaskRec=(Mask:(($FFF0,$FFE0,$FFC0,$FF81,$FF03,$0607,$000F,$001F,$C03F,$F07F,$FFFF,$FFFF,$FFFF,$FFFF,
  25.      $FFFF,$FFFF),($0000,$0006,$000C,$0018,$0030,$0060,$70C0,$1D80,$0700,$0000,$0000,$0000,$0000,$0000,$0000,$0000));X:6;Y:7);
  26.      PointingHandCursor:MaskRec=(Mask:(($E1FF,$E1FF,$E1FF,$E1FF,$E1FF,$E000,$E000,$E000,$0000,$0000,$0000,$0000,$0000,$0000,
  27.      $0000,$0000),($1E00,$1200,$1200,$1200,$1200,$13FF,$1249,$1249,$F249,$9001,$9001,$9001,$8001,$8001,$8001,$FFFF));X:5;Y:0);
  28.      DiagonalCrossCursor:MaskRec=(Mask:(($07E0,$0180,$0000,$C003,$F00F,$C003,$0000,$0180,$07E0,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,
  29.      $FFFF,$FFFF),($0000,$700E,$1C38,$0660,$03C0,$0660,$1C38,$700E,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));X:7;Y:4);
  30.      RectangleCrossCursor:MaskRec=(Mask:(($FC3F,$FC3F,$FC3F,$0000,$0000,$0000,$FC3F,$FC3F,$FC3F,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,
  31.      $FFFF,$FFFF),($0000,$0180,$0180,$0180,$7FFE,$0180,$0180,$0180,$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000));X:7;Y:4);
  32.      HourGlassCursor:MaskRec=(Mask:(($0000,$0000,$0000,$0000,$8001,$C003,$E007,$F00F,$E007,$C003,$8001,$0000,$0000,$0000,$0000,
  33.      $FFFF),($0000,$7FFE,$6006,$300C,$1818,$0C30,$0660,$03C0,$0660,$0C30,$1998,$33CC,$67E6,$7FFE,$0000,$0000));X:7;Y:7);
  34.  
  35. PROCEDURE ResetMouse;
  36. PROCEDURE ShowMouse;
  37. PROCEDURE HideMouse;
  38. PROCEDURE MousePos(VAR X,Y:Word);
  39. FUNCTION LeftButton:Boolean;
  40. FUNCTION RightButton:Boolean;
  41. PROCEDURE PutMouse(X,Y:Word);
  42. FUNCTION ButtonPressInfo(Button:Byte; VAR PressCount,X,Y:Word):Boolean;
  43. FUNCTION ButtonReleaseInfo(Button:Byte; VAR PressCount,X,Y:Word):Boolean;
  44. PROCEDURE SetHorizontalRange(Min,Max:Word);
  45. PROCEDURE SetVerticalRange(Min,Max:Word);
  46. FUNCTION MouseInBox(X1,Y1,X2,Y2:Word):Boolean;
  47. PROCEDURE SetGraphicsCursor(VAR MaskP:MaskRec);
  48. PROCEDURE SetTextCursor(Sel,Start,Stop:Word);
  49. PROCEDURE MotionCounters(VAR X,Y:Integer);
  50. PROCEDURE LightPenEmulation(F:Boolean);
  51. PROCEDURE ConditionalOff(UX,UY,LX,LY:Word);
  52. PROCEDURE DoubleSpeedThreshold(Mickey:Word);
  53. PROCEDURE SetMouseProcedure(M:Word; P:Pointer);
  54. PROCEDURE CursorMirror(VAR S,D:MaskRec; F:Byte);
  55.  
  56. IMPLEMENTATION
  57.  
  58. VAR
  59.    CrtMode:Byte ABSOLUTE $40:$49;
  60.    MouseHandler,ExitSave,Int1BSave,OldCursor:Pointer;
  61. CONST
  62.      M1:Word=0;
  63.      M2:Word=0;
  64.      M3:Word=0;
  65.      M4:Word=0;
  66.      M5:Word=0;
  67.      M6:Word=0;
  68.      MaxX:Integer=719;
  69.      MaxY:Integer=347;
  70.      SegPointer:Word=$FFFF;
  71.      AboFlag:Boolean=FALSE;
  72.      Hercules:Boolean=FALSE;
  73.  
  74. FUNCTION BitSet(TestByte,BitNumber:Byte):Boolean;
  75. BEGIN
  76.      TestByte:=TestByte AND (1 SHL BitNumber);
  77.      BitSet:=TestByte>0;
  78. END;
  79.  
  80. PROCEDURE CheckPos(VAR X,Y:Word);
  81. BEGIN
  82.      IF Y>MaxY THEN
  83.         Y:=MaxY;
  84.      IF X>MaxX THEN
  85.         X:=MaxX;
  86. END;
  87.  
  88. PROCEDURE Mouse;
  89. VAR
  90.    Regs:Registers;
  91. BEGIN
  92.      WITH Regs DO
  93.      BEGIN
  94.           AX:=M1;
  95.           BX:=M2;
  96.           CX:=M3;
  97.           DX:=M4;
  98.           SI:=M5;
  99.           DI:=M6;
  100.           ES:=SegPointer;
  101.           Intr(51,Regs);
  102.           M1:=AX;
  103.           M2:=BX;
  104.           M3:=CX;
  105.           M4:=DX;
  106.      END;
  107. END;
  108.  
  109. PROCEDURE ShowMouse;
  110. BEGIN
  111.      M1:=1;
  112.      Mouse;
  113. END;
  114.  
  115. PROCEDURE HideMouse;
  116. BEGIN
  117.      M1:=2;
  118.      Mouse;
  119. END;
  120.  
  121. PROCEDURE MousePos(VAR X,Y:Word);
  122. BEGIN
  123.      M1:=3;
  124.      Mouse;
  125.      X:=M3;
  126.      Y:=M4;
  127.      IF AboFlag THEN
  128.      BEGIN
  129.           NoSound;
  130.           WriteLn('Break');
  131.           Halt(1);
  132.      END;
  133. END;
  134.  
  135. FUNCTION LeftButton:Boolean;
  136. BEGIN
  137.      M1:=3;
  138.      Mouse;
  139.      IF BitSet(M2,LeftB) THEN
  140.         LeftButton:=TRUE
  141.      ELSE LeftButton:=FALSE;
  142. END;
  143.  
  144. FUNCTION RightButton:Boolean;
  145. BEGIN
  146.      M1:=3;
  147.      Mouse;
  148.      IF BitSet(M2,RightB) THEN
  149.         RightButton:=TRUE
  150.      ELSE RightButton:=FALSE;
  151. END;
  152.  
  153. PROCEDURE PutMouse(X,Y:Word);
  154. BEGIN
  155.      CheckPos(X,Y);
  156.      M1:=4;
  157.      M3:=X;
  158.      M4:=Y;
  159.      Mouse;
  160. END;
  161.  
  162. FUNCTION ButtonPressInfo(Button:Byte; VAR PressCount,X,Y:Word):Boolean;
  163. BEGIN
  164.      M1:=5;
  165.      M2:=Button;
  166.      Mouse;
  167.      ButtonPressInfo:=BitSet(M1,Button);
  168.      PressCount:=M2;
  169.      X:=M3;
  170.      Y:=M4;
  171. END;
  172.  
  173. FUNCTION ButtonReleaseInfo(Button:Byte; VAR PressCount,X,Y:Word):Boolean;
  174. BEGIN
  175.      M1:=6;
  176.      M2:=Button;
  177.      Mouse;
  178.      ButtonReleaseInfo:=NOT BitSet(M1,Button);
  179.      PressCount:=M2;
  180.      X:=M3;
  181.      Y:=M4;
  182. END;
  183.  
  184. PROCEDURE SetHorizontalRange(Min,Max:Word);
  185. VAR
  186.    Dummy:Word;
  187. BEGIN
  188.      CheckPos(Min,Dummy);
  189.      CheckPos(Max,Dummy);
  190.      M1:=7;
  191.      M3:=Min;
  192.      M4:=Max;
  193.      Mouse;
  194. END;
  195.  
  196. PROCEDURE SetVerticalRange(Min,Max:Word);
  197. VAR
  198.    Dummy:Word;
  199. BEGIN
  200.      CheckPos(Dummy,Min);
  201.      CheckPos(Dummy,Max);
  202.      M1:=8;
  203.      M3:=Min;
  204.      M4:=Max;
  205.      Mouse;
  206. END;
  207.  
  208. FUNCTION MouseInBox(X1,Y1,X2,Y2:Word):Boolean;
  209. VAR
  210.    X,Y:Word;
  211. BEGIN
  212.      IF X2<X1 THEN
  213.      BEGIN
  214.           X:=X1;
  215.           X1:=X2;
  216.           X2:=X;
  217.      END;
  218.      IF Y2<Y1 THEN
  219.      BEGIN
  220.           Y:=Y1;
  221.           Y1:=Y2;
  222.           Y2:=Y
  223.      END;
  224.      MousePos(X,Y);
  225.      MouseInBox:=(X>=X1) AND (X<=X2-1) AND (Y>=Y1) AND (Y<=Y2-1);
  226. END;
  227.  
  228. PROCEDURE SetGraphicsCursor(VAR MaskP:MaskRec);
  229. BEGIN
  230.      IF OldCursor<>@MaskP THEN
  231.      BEGIN
  232.           OldCursor:=@MaskP;
  233.           WITH MaskP DO
  234.           BEGIN
  235.                M1:=9;
  236.                M2:=X;
  237.                M3:=Y;
  238.                M4:=Ofs(Mask);
  239.                SegPointer:=Seg(Mask);
  240.           END;
  241.      END;
  242.      Mouse;
  243. END;
  244.  
  245. PROCEDURE SetTextCursor(Sel,Start,Stop:Word);
  246. BEGIN
  247.      M1:=10;
  248.      M2:=Sel;
  249.      M3:=Start;
  250.      M4:=Stop;
  251.      Mouse;
  252. END;
  253.  
  254. PROCEDURE MouseRatio(X,Y:Word);
  255. BEGIN
  256.      M1:=15;
  257.      M3:=X;
  258.      M4:=Y;
  259. END;
  260.  
  261. PROCEDURE MotionCounters(VAR X,Y:Integer);
  262. VAR
  263.    X1,Y1:LongInt;
  264. BEGIN
  265.      M1:=11;
  266.      Mouse;
  267.      IF M3>$FFF THEN
  268.         X1:=M3-65536
  269.      ELSE X1:=M3;
  270.      IF M4>$FFF THEN
  271.         Y1:=M4-65536
  272.      ELSE Y1:=M4;
  273.      X:=X1;
  274.      Y:=Y1;
  275. END;
  276.  
  277. PROCEDURE LightPenEmulation(F:Boolean);
  278. BEGIN
  279.      IF F THEN
  280.         M1:=13
  281.      ELSE M1:=14;
  282.      Mouse;
  283. END;
  284.  
  285. PROCEDURE ConditionalOff(UX,UY,LX,LY:Word);
  286. BEGIN
  287.      M1:=16;
  288.      IF UX<LX THEN
  289.      BEGIN
  290.           M3:=UX;
  291.           M5:=LX;
  292.      END
  293.      ELSE
  294.      BEGIN
  295.           M3:=LX;
  296.           M5:=UX;
  297.      END;
  298.      IF UY<LY THEN
  299.      BEGIN
  300.           M4:=UY;
  301.           M6:=LY;
  302.      END
  303.      ELSE
  304.      BEGIN
  305.           M4:=LY;
  306.           M6:=UY;
  307.      END;
  308.      Mouse;
  309. END;
  310.  
  311. PROCEDURE DoubleSpeedThreshold(Mickey:Word);
  312. BEGIN
  313.      M1:=19;
  314.      M4:=Mickey;
  315.      Mouse;
  316. END;
  317.  
  318. PROCEDURE MouseCallExit;
  319. BEGIN
  320.      InLine($5D/$58/$89/$EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$5B/$58/$CB);
  321. END;
  322.  
  323. PROCEDURE UserHandlerCall(Mask,Button,X,Y:Word);
  324. InLine($FF/$1E/MouseHandler);
  325.  
  326. PROCEDURE MouseInterrupt(Flags,CS,IP,AX,BX,CX,DX,SI,DI,ES,BP:Word); INTERRUPT;
  327. BEGIN
  328.      UserHandlerCall(AX,BX,CX,DX);
  329.      MouseCallExit;
  330. END;
  331.  
  332. PROCEDURE SetMouseProcedure(M:Word; P:Pointer);
  333. BEGIN
  334.      M1:=12;
  335.      M3:=M;
  336.      M4:=Ofs(MouseInterrupt);
  337.      SegPointer:=Seg(MouseInterrupt);
  338.      MouseHandler:=P;
  339.      Mouse;
  340. END;
  341.  
  342.  
  343. FUNCTION BitInvert(B:Word):Word;
  344. InLine($58/$B9/$10/$00/$33/$DB/$D1/$D0/$D1/$DB/$E2/$FA/$8B/$C3);
  345.  
  346. PROCEDURE CursorMirror(VAR S,D:MaskRec; F:Byte);
  347. VAR
  348.    I,K:Byte;
  349. BEGIN
  350.      FOR I:=0 TO 1 DO
  351.      BEGIN
  352.           FOR K:=0 TO 15 DO
  353.           BEGIN
  354.                IF (F AND 1)>0 THEN
  355.                   D.Mask[I,K]:=S.Mask[I,15-K]
  356.                ELSE D.Mask[I,K]:=S.Mask[I,K];
  357.                IF (F AND 2)>0 THEN
  358.                   D.Mask[I,K]:=BitInvert(D.Mask[I,K]);
  359.           END;
  360.      END;
  361.      IF (F AND 1)>0 THEN
  362.         D.Y:=15-S.Y
  363.      ELSE D.Y:=S.Y;
  364.      IF (F AND 2)>0 THEN
  365.         D.X:=15-S.X
  366.      ELSE D.X:=S.X;
  367. END;
  368.  
  369. PROCEDURE ResetMouse;
  370. VAR
  371.    Size:Word;
  372.    Save:Boolean;
  373. BEGIN
  374.      Hercules:=Mem[$40:$49]=7;
  375.      M1:=0;
  376.      Mouse;
  377.      MaxX:=639;
  378.      MaxY:=199;
  379.      SetHorizontalRange(0,MaxX);
  380.      SetVerticalRange(0,MaxY);
  381. END;
  382.  
  383. PROCEDURE CallOld1B;
  384. InLine($9C/$FF/$1E/Int1BSave);
  385.  
  386. {$F+ }
  387. PROCEDURE Int1B; INTERRUPT;
  388. {$F- }
  389. BEGIN
  390.      SetIntVec($1B,Int1BSave);
  391.      CallOld1B;
  392.      AboFlag:=TRUE;
  393. END;
  394.  
  395. {$F+ }
  396. PROCEDURE MouseExit;
  397. {$F- }
  398. BEGIN
  399.      M1:=0;
  400.      Mouse;
  401.      NoSound;
  402.      IF Hercules THEN
  403.         CrtMode:=7;
  404.      ExitProc:=ExitSave;
  405. END;
  406.  
  407. BEGIN
  408.      M1:=0;
  409.      Mouse;
  410.      IF NOT (M1=65535) THEN
  411.      BEGIN
  412.           ClrScr;
  413.           GotoXY(20,12);
  414.           Write('MS Maustreiber nicht installiert !');
  415.           Halt(1);
  416.      END;
  417.      MaxX:=79;
  418.      MaxY:=24;
  419.      ClrScr;
  420.      CursorMirror(LeftArrowCursor,RightArrowCursor,2);
  421.      CursorMirror(UpArrowCursor,DownArrowCursor,1);
  422.      CursorMirror(StandardCursor,InvertedCursor,3);
  423.      ExitSave:=ExitProc;
  424.      ExitProc:=@MouseExit;
  425.      GetIntVec($1B,Int1BSave);
  426.      SetIntVec($1B,@Int1B);
  427. END.
  428.